home *** CD-ROM | disk | FTP | other *** search
/ Tech Arsenal 1 / Tech Arsenal (Arsenal Computer).ISO / tek-02 / nrpas13.zip / SPLINE.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  1KB  |  39 lines
  1. PROCEDURE spline(x,y: glnarray; n: integer; yp1,ypn: real;
  2.        VAR y2: glnarray);
  3. (* Programs using routine SPLINE must define the type
  4. TYPE
  5.    glnarray = ARRAY [1..n] OF real;
  6. in the main routine. *)
  7. VAR
  8.    i,k: integer;
  9.    p,qn,sig,un: real;
  10.    u: glnarray;
  11. BEGIN
  12.    IF (yp1 > 0.99e30) THEN BEGIN
  13.       y2[1] := 0.0;
  14.       u[1] := 0.0
  15.    END ELSE BEGIN
  16.       y2[1] := -0.5;
  17.       u[1] := (3.0/(x[2]-x[1]))*((y[2]-y[1])/(x[2]-x[1])-yp1)
  18.    END;
  19.    FOR i := 2 TO n-1 DO BEGIN
  20.       sig := (x[i]-x[i-1])/(x[i+1]-x[i-1]);
  21.       p := sig*y2[i-1]+2.0;
  22.       y2[i] := (sig-1.0)/p;
  23.       u[i] := (y[i+1]-y[i])/(x[i+1]-x[i])
  24.          -(y[i]-y[i-1])/(x[i]-x[i-1]);
  25.       u[i] := (6.0*u[i]/(x[i+1]-x[i-1])-sig*u[i-1])/p
  26.    END;
  27.    IF (ypn > 0.99e30) THEN BEGIN
  28.       qn := 0.0;
  29.       un := 0.0
  30.    END ELSE BEGIN
  31.       qn := 0.5;
  32.       un := (3.0/(x[n]-x[n-1]))*(ypn-(y[n]-y[n-1])/(x[n]-x[n-1]))
  33.    END;
  34.    y2[n] := (un-qn*u[n-1])/(qn*y2[n-1]+1.0);
  35.    FOR k := n-1 DOWNTO 1 DO BEGIN
  36.       y2[k] := y2[k]*y2[k+1]+u[k]
  37.    END
  38. END;
  39.